#===============
# * 2013 Copyright Matthew Caswell
# * Pool.pl
#-------
# * Pool language translator/compiler.
# * P.O.O.L - Perl Object Oriented Language
#===============

# __START Package
package PoolCompiler::Compiler;
# __END Package

# __START Perl
use strict;
use Data::Dumper;
# __END Perl

# __START NonPerl
use PoolCompiler::Exception;
# __END NonPerl

# __START Compiler

# compile(@ARGV) -- Organizes arguments and calls Interperet($classHandle, $dbg)
sub compile(@){
  my @argumentVector = @_;
  
  my $dbg;
  
  if($argumentVector[3] eq "?d"){
    $dbg = 1;
  }else{
    $dbg = 0;
  }
  
  my($inClassFile, $outClassFile) = @argumentVector[1..2];
  
  $dbg == 1 && print "[DBG] Fixing class file names\n";
  
  $inClassFile .= ".pool";
  $outClassFile .= ".pm";
  
  $dbg == 1 && print "[DBG] Opening inClassFile: $inClassFile\n";
  
  local *ClassFileHandle;
  open ClassFileHandle, $inClassFile
  or die "[STDERR] Pool compiler: $inClassFile: ".FAILED_TO_OPEN_CLASS." : $!\n";
  
  my $classHandle = \*ClassFileHandle;
  
  $dbg == 1 && print "[DBG] Starting interpereter...\n";
  (my $POOLedPackageRef, $dbg) = Interperet($classHandle, $dbg, $outClassFile);
  
  $dbg == 1 && print "[DBG] Opening outClassFile: $outClassFile\n";
  
  local *NewClassHandle;
  open NewClassHandle, ">$outClassFile"
    or die "[STDERR] Pool compiler: $outClassFile: ".FAILED_TO_OPEN_CLASS." : $!\n";
  
  $dbg == 1 && print "[DBG] Unloading class...\n";
  
  print NewClassHandle ${$POOLedPackageRef};
  
  close NewClassHandle;

  $dbg == 1 && print "[DBG] Done";  
  exit();
}

# Interperet($classHandle, $dbg) -- Interperets and constructs the program
# -- returns a string reference to the compiled code
sub Interperet($){
  my($classHandle, $dbg, $PoolExportClassFile) = @_;
  
  my $PoolClass = do{ local $/; <$classHandle> };
  
  close $classHandle;
  
  $dbg == 1 && print "[DBG] Starting Pool fragmentation\n";
  
  my @lines = grep length, split /\n/, $PoolClass;
  
  my $inClass = 0;
  my $POOLedPackageNameStub;
  my $PackageSet = 0;
  my $InternalOn;
  my $localOn;
  my $inExport;
  my $POOLedPackageOriginalName;
  my $inlineState = 0;
  my $POOLedPackage;
  
  for my $index (0..$#lines){
    my $lineNu = $index+1;
    my @thisline = grep length, split /[\s\(\)]/, $lines[$index];
    my @decl = grep length, split /\s/, $lines[$index];
    my @typic = grep length, split /[\(\)]/, $lines[$index];
    my @lineChar = split '', $thisline[0];
    
    # This is for a later version of Pool
    my @methodic = grep length, split /[\{\}]/, $lines[$index];
    my @newl = grep length, split /\n/, $lines[$index];
    
    # This is for now.
    if($thisline[0] eq "package"){
      $dbg == 1 && print "[DBG] Found package\n";
      
      my @packName = grep length, split '', $thisline[1];
      
      if($packName[$#packName] eq ';'){
        $thisline[1] = join('', @packName[0..$#packName-1]);
        $POOLedPackageOriginalName = $thisline[1];
        @packName = grep length, split /\./, $thisline[1];
        my $POOLPackName;
        
        if($#packName != 0){
          $dbg == 1 && print "[DBG] Fixing package name\n";
          
          $POOLPackName = join("::", @packName);
        }else{
          $POOLPackName = $thisline[1];
        }
        $POOLedPackageNameStub .= "package $POOLPackName";
      }else{
        PoolCompiler::Exception::Throw(SEMIC_EXPECTED_EOL, $lineNu);
      }
    }elsif($thisline[0] eq "export" && $inClass == 0){
      $dbg == 1 && print "[DBG] Found export\n";
      
      my @className = grep length, split '', $thisline[1];
      my $RealClassName;
      
      if($className[$#className] eq "{"){
        $RealClassName = join('', @className[0..$#className-1]);
      }else{
        $RealClassName = join('', @className);
      }
      
      $dbg == 1 && print "[DBG] Fixing class names\n";
      
      $POOLedPackage .= <<EOF;
#===============================================
# * This Perl module has been generated by     *
# * Matthew Caswell's original Pool compiler   *
# * (which was also written in Perl).          *
# * The data and text below should be correct, *
# * and should follow the basic structure of   *
# * a Pool export class (which is translated   *
# * to Perl and stuck in a module).            *
# * ------------------------------------------ *
# * This module's original name:               *
# * $PoolExportClassFile                       
# * This module's original package name:       *
# * $POOLedPackageOriginalName                     
# * This module's original class name:         *
# * $RealClassName                             
#===============================================
EOF
      $POOLedPackage .= $POOLedPackageNameStub . "::" . $RealClassName . ";\n\nuse strict;\n";

      $inClass = 1;
      $PackageSet = 1;
    }elsif($thisline[0] eq "export" && $inClass == 1){
      $dbg == 1 && print "[DBG] Found method export decl\n";
      
      $inExport = 1;
  
      my $exportName = $thisline[2];
      $POOLedPackage .= "\nsub $exportName {\n";
      
      if($thisline[3] eq "vector"){
        $POOLedPackage .= "my \@$thisline[4] = \@_;\n";
      }elsif($thisline[3] eq "void"){}
      elsif($thisline[3] eq "string" || $thisline[3] eq "int" || $thisline[3] eq "ref"){
        $POOLedPackage .= "my \$$thisline[4] = shift;\n";
      }else{
        PoolCompiler::Exception::Throw(UT_IN_EXPORT_DECL, $lineNu);
      }
    }elsif($thisline[0] eq "internal"){
      $dbg == 1 && print "[DBG] Found method internal decl\n";
      
      my $internalName = $thisline[2];
      
      $POOLedPackage .= "sub __$internalName {\n  ";
      
      if($thisline[3] eq "vector"){
        $POOLedPackage .= "my \@$thisline[4] = \@_;\n";
      }elsif($thisline[3] eq "void"){}
      elsif($thisline[3] eq "string" || $thisline[3] eq "int" || $thisline[3] eq "ref"){
        $POOLedPackage .= "my \$$thisline[4] = shift;\n";
      }else{
        PoolCompiler::Exception::Throw(UT_IN_INTERNAL_DECL, $lineNu);
      }
      
      $InternalOn = 1;
    }elsif($decl[0] eq "Console.println"){
      $POOLedPackage .= "print STDOUT ";
      my@cc = grep length, split '', $thisline[1];
      
      if($cc[0] eq "\""){
        $POOLedPackage .= join(" ", @decl[1..$#decl]);
      }elsif($thisline[1] eq "vector"){
      $POOLedPackage .= "\@".$thisline[2].";";
      }elsif($thisline[1] eq "string" || $thisline[1] eq "int" || $thisline[1] eq "ref"){
        $POOLedPackage .= "\$".$thisline[2].";";
      }elsif($thisline[1] eq "meth.i"){
        $POOLedPackage .= "__$thisline[2](";
        if($thisline[3] eq "vector"){
          $POOLedPackage .= "\@".$thisline[4].");";
        }elsif($thisline[3] eq "string" || $thisline[3] eq "int" || $thisline[3] eq "ref"){
          $POOLedPackage .= "\$$thisline[4]);";
        }elsif($thisline[3] eq "void"){
          $POOLedPackage .= ");";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_I, $lineNu);
        }
      }elsif($thisline[1] eq "meth.e"){
        my @nameOfClass = grep length, split /\./, $thisline[2];
        my $nameReal;
        
        if($#nameOfClass != 0){
          $nameReal = join("::", @nameOfClass);
        }else{
          $nameReal = $thisline[2];
        }
        
        $POOLedPackage .= $nameReal . "(";
        
        my @cc = grep length, split '', $thisline[3];
        if($cc[0] eq "\""){
          $POOLedPackage .= join(" ", @thisline[3..$#thisline-1]);
          $POOLedPackage .= ");\n";
        }elsif($thisline[3] eq "vector"){
          $POOLedPackage .= "\@".$thisline[4].");\n";
        }elsif($thisline[3] eq "void"){
          $POOLedPackage .= ");\n";
        }elsif($thisline[3] eq "string" || $thisline[3] eq "int" || $thisline[3] eq "ref"){
          $POOLedPackage .= "\$$thisline[4]);";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_E, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(UT_IN_C_P, $lineNu);
      }
      $POOLedPackage .= "\n";
    }elsif($thisline[0] eq "}" && $inlineState == 0){
      
      if($InternalOn == 1){
        $POOLedPackage .= "}\n";
        $InternalOn = 0;
      }elsif($inClass == 1 && $InternalOn == 0
        && $inExport == 0){
        $POOLedPackage .= "\n1;";
        $inClass = 0;
      }elsif($inExport == 1 && $inClass == 1){
        $POOLedPackage .= "}\n";
        $inExport = 0;
      }else{
        PoolCompiler::Exception::Throw(STRAY_WRAP, $lineNu);
      }
    }elsif($thisline[0] eq "this.method"){
      my $internalMethodCallName = "__$thisline[1](";
      my @cc = grep length, split '', $thisline[2];
      
      if($cc[0] eq "\""){
        $internalMethodCallName .= "(".join(" ", @thisline[2..$#thisline-1])."))";
      }elsif($thisline[2] eq "vector"){
        $internalMethodCallName .= "(\@".$thisline[3].")";
      }elsif($thisline[2] eq "void"){
        $internalMethodCallName .= "()";
      }elsif($thisline[2] eq "string" || $thisline[2] eq "int" || $thisline[2] eq "ref"){
        $internalMethodCallName .= "\$".$thisline[3].")";
      }elsif($thisline[2] eq "meth.i"){
        $internalMethodCallName .= "__$thisline[3](";
        if($thisline[4] eq "vector"){
          $internalMethodCallName .= "\@".$thisline[5]."))";
        }elsif($thisline[4] eq "string" || $thisline[4] eq "int" || $thisline[4] eq "ref"){
          $internalMethodCallName .= "\$$thisline[5]))";
        }elsif($thisline[4] eq "void"){
          $internalMethodCallName .= "))";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_I, $lineNu);
        }
      }elsif($thisline[3] eq "meth.e"){
        my @nameOfClass = grep length, split /\./, $thisline[4];
        my $nameReal;
        
        if($#nameOfClass != 0){
          $nameReal = join("::", @nameOfClass);
        }else{
          $nameReal = $thisline[4];
        }
        
        $internalMethodCallName .= $nameReal . "(";
        
        my @cc = grep length, split '', $thisline[5];
        if($cc[0] eq "\""){
          $internalMethodCallName .= join(" ", @thisline[5..$#thisline-1]);
          $internalMethodCallName .= ")";
        }elsif($thisline[5] eq "vector"){
          $internalMethodCallName .= "\@".$thisline[6].")";
        }elsif($thisline[5] eq "void"){
          $internalMethodCallName .= ")\n";
        }elsif($thisline[5] eq "string" || $thisline[5] eq "int" || $thisline[5] eq "ref"){
          $internalMethodCallName .= "\$$thisline[6])";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_E, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(UT_IN_THIS_METHOD, $lineNu);
      }
      $POOLedPackage .= "$internalMethodCallName;\n";
    }elsif($thisline[0] eq "import"){
      
      $dbg == 1 && print "[DBG] Found imported package\n";
      
      my @importPackageArray = grep length, split '', $thisline[1];
      
      if($importPackageArray[$#importPackageArray] eq ";"){
        my $importPackageName = join('', @importPackageArray[0..$#importPackageArray-1]);
        @importPackageArray = grep length, split /\./, $importPackageName;
        $importPackageName = join("::", @importPackageArray);
        $POOLedPackage .= "use $importPackageName;\n";
      }else{
        PoolCompiler::Exception::Throw(SEMIC_EXPECTED_EOL, $lineNu);
      }
    }elsif($thisline[0] eq "method"){
      @thisline = grep length, split /[\s\(\)]/, $lines[$index];
      my @nameOfClass = grep length, split /\./, $thisline[1];
      my $nameReal;

      if($#nameOfClass != 0){
        $nameReal = join("::", @nameOfClass);
      }else{
        $nameReal = $thisline[1];
      }

      $POOLedPackage .= $nameReal . "(";
      
      my @cc = grep length, split '', $thisline[2];
      if($cc[0] eq "\""){
        $POOLedPackage .= join(" ", @thisline[2..$#thisline-1]);
        $POOLedPackage .= ");\n";
      }elsif($thisline[2] eq "vector"){
        $POOLedPackage .= "\@".$thisline[3].");\n";
      }elsif($thisline[2] eq "void"){
        $POOLedPackage .= ");\n";
      }elsif($thisline[2] eq "string" || $thisline[2] eq "int" || $thisline[2] eq "ref"){
        $POOLedPackage .= "\$".$thisline[3].");\n";
      }elsif($thisline[2] eq "meth.i"){
        $POOLedPackage .= "__$thisline[3](";
        if($thisline[4] eq "vector"){
          $POOLedPackage .= "\@".$thisline[5].")";
        }elsif($thisline[4] eq "string" || $thisline[4] eq "int" || $thisline[4] eq "ref"){
          $POOLedPackage .= "\$$thisline[5])";
        }elsif($thisline[4] eq "void"){
          $POOLedPackage .= ");\n";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_I, $lineNu);
        }
      }elsif($thisline[3] eq "meth.e"){
        @nameOfClass = grep length, split /\./, $thisline[4];
        $nameReal;
        
        if($#nameOfClass != 0){
          $nameReal = join("::", @nameOfClass);
        }else{
          $nameReal = $thisline[4];
        }
        
        $POOLedPackage .= $nameReal . "(";
        
        my @cc = grep length, split '', $thisline[5];
        if($cc[0] eq "\""){
          $POOLedPackage .= join(" ", @thisline[5..$#thisline-1]);
          $POOLedPackage .= ");\n";
        }elsif($thisline[5] eq "vector"){
          $POOLedPackage .= "\@".$thisline[6].");\n";
        }elsif($thisline[5] eq "void"){
          $POOLedPackage .= ");\n";
        }elsif($thisline[5] eq "string" || $thisline[5] eq "int" || $thisline[5] eq "ref"){
          $POOLedPackage .= "\$$thisline[6]);\n";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_E, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(UT_IN_METHOD, $lineNu);
      }
    }elsif($thisline[0] eq "__inline.Perl__"
      && $inlineState == 0){
      $inlineState = 1;
      $dbg == 1 && print "[DBG] inlineState is true\n";
    }elsif($thisline[0] ne "__inline.end__"
      && $inlineState == 1){
      $POOLedPackage .= $lines[$index]."\n";
    }elsif($inlineState == 1 && $thisline[0] eq "__inline.end__"){
      $dbg == 1 && print "[DBG] inlineState is false\n";
      $inlineState = 0;
    }elsif($inlineState == 0 && $thisline[0] eq "__inline.end__"){
      PoolCompiler::Exception::Throw(BAD_INLINE_EXIT, $lineNu);
    }elsif($thisline[0] eq "return" && ($inExport == 1 || $InternalOn == 1)){
      $POOLedPackage .= "return(";
      
      if($thisline[1] eq "vector"){
        $POOLedPackage .= "\@".$thisline[2];
      }elsif($thisline[1] eq "string" || $thisline[1] eq "int" || $thisline[1] eq "ref"){
        $POOLedPackage .= "\$".$thisline[2];
      }elsif($thisline[1] eq "void"){}
      elsif($thisline[1] eq "meth.i"){
        $POOLedPackage .= "__$thisline[2](";
        if($thisline[3] eq "vector"){
          $POOLedPackage .= "\@".$thisline[4].")";
        }elsif($thisline[3] eq "string" || $thisline[3] eq "int" || $thisline[3] eq "ref"){
          $POOLedPackage .= "\$$thisline[4])";
        }elsif($thisline[3] eq "void"){
          $POOLedPackage .= ")";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_I, $lineNu);
        }
      }elsif($thisline[1] eq "meth.e"){
        my @nameOfClass = grep length, split /\./, $thisline[2];
        my $nameReal;
        
        if($#nameOfClass != 0){
          $nameReal = join("::", @nameOfClass);
        }else{
          $nameReal = $thisline[1];
        }
        
        $POOLedPackage .= $nameReal . "(";
        
        my @cc = grep length, split '', $thisline[3];
        
        if($cc[0] eq "\""){
          $POOLedPackage .= join(" ", @thisline[3..$#thisline-1]);
          $POOLedPackage .= ");\n";
        }elsif($thisline[3] eq "vector"){
          $POOLedPackage .= "\@".$thisline[4].");\n";
        }elsif($thisline[3] eq "void"){
          $POOLedPackage .= ");\n";
        }elsif($thisline[3] eq "string" || $thisline[3] eq "int" || $thisline[3] eq "ref"){
          $POOLedPackage .= "\$$thisline[4])";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_METH_E, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(UT_IN_RETURN, $lineNu);
      }
      
      $POOLedPackage .= ");\n";
    }elsif($thisline[0] eq "var"){
      if($thisline[3] eq "="){
        my ($beforeOp, @afterOp) = grep length, split /=/, $lines[$index];
        
        my @bOI = grep length, split /[\s\(\)]/, $beforeOp;
        if($bOI[1] eq "vector"){
         $POOLedPackage .= "my \@$thisline[2] = ".join(/=/, @afterOp[0..$#afterOp])."\n";
        }elsif($thisline[1] eq "string" || $thisline[1] eq "int" || $thisline[1] eq "ref"){
          $POOLedPackage .= "my \$$thisline[2] = ".join(/=/, @afterOp[0..$#afterOp])."\n";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_VAR_DECL, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(EQ_EXPECTED, $lineNu);
      }
    }elsif($thisline[0] eq "revar"){
      if($thisline[3] eq "="){
        my ($beforeOp, @afterOp) = grep length, split /=/, $lines[$index];
        
        my @bOI = grep length, split /[\s\(\)]/, $beforeOp;
        if($bOI[1] eq "vector"){
         $POOLedPackage .= "\@$thisline[2] = ".join(/=/, @afterOp[0..$#afterOp])."\n";
        }elsif($thisline[1] eq "string" || $thisline[1] eq "int" || $thisline[1] eq "ref"){
          $POOLedPackage .= "\$$thisline[2] = ".join(/=/, @afterOp[0..$#afterOp])."\n";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_VAR_DECL, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(EQ_EXPECTED, $lineNu);
      }
    }elsif($thisline[0] eq "append"){
      if($thisline[3] eq "="){
        my ($beforeOp, @afterOp) = grep length, split /=/, $lines[$index];
        
        my @bOI = grep length, split /[\s\(\)]/, $beforeOp;
        if($bOI[1] eq "vector"){
         $POOLedPackage .= "my \@$thisline[2] = ".join(/=/, @afterOp[0..$#afterOp])."\n";
        }elsif($thisline[1] eq "string" || $thisline[1] eq "int" || $thisline[1] eq "ref"){
          $POOLedPackage .= "my \$$thisline[2] = ".join(/=/, @afterOp[0..$#afterOp])."\n";
        }else{
          PoolCompiler::Exception::Throw(UT_IN_VAR_DECL, $lineNu);
        }
      }else{
        PoolCompiler::Exception::Throw(EQ_EXPECTED, $lineNu);
      }
    }elsif($lineChar[0] eq "/" && $lineChar[1] eq "/"){
      $POOLedPackage .= "# __SRC:COMMENT\n# $lines[$index]\n";
    }elsif($lineChar[0] eq "!") {
      PoolCompiler::Exception::Throw(OUTDATED_COMMENT, $lineNu);
    }
  }
  
  return \$POOLedPackage;
}

# __END Compiler
1;
